Visual Basic Source Code/Visual Basic Source Code.iso/vbsource/shufl1/sound1.frm

Visual Basic Form | 1995-05-08 | 10.3 KB | 348 lines

VERSION 2.00
Begin Form Sound1
   Caption         =   "System Sound Shuffler"
   ClientHeight    =   3870
   ClientLeft      =   1185
   ClientTop       =   1545
   ClientWidth     =   7890
   Height          =   4275
   Icon            =   SOUND1.FRX:0000
   Left            =   1125
   LinkMode        =   1  'Source
   LinkTopic       =   "Form1"
   ScaleHeight     =   3870
   ScaleWidth      =   7890
   Top             =   1200
   Width           =   8010
   Begin CommonDialog CMDialog1
      Left            =   5400
      Top             =   4320
   End
   Begin CommandButton Command1
      Caption         =   "E&xit"
      Height          =   375
      Index           =   5
      Left            =   6300
      TabIndex        =   14
      Top             =   3120
      Width           =   1335
   End
   Begin CommandButton Command1
      Caption         =   "Shu&ffle"
      Height          =   375
      Index           =   4
      Left            =   6300
      TabIndex        =   13
      Top             =   2580
      Width           =   1335
   End
   Begin CommandButton Command1
      Caption         =   "&Set Current"
      Height          =   375
      Index           =   3
      Left            =   6300
      TabIndex        =   12
      Top             =   2040
      Width           =   1335
   End
   Begin CommandButton Command1
      Caption         =   "&Play File"
      Height          =   375
      Index           =   2
      Left            =   6300
      TabIndex        =   11
      Top             =   1500
      Width           =   1335
   End
   Begin CommandButton Command1
      Caption         =   "&Remove File"
      Height          =   375
      Index           =   1
      Left            =   6300
      TabIndex        =   10
      Top             =   960
      Width           =   1335
   End
   Begin CommandButton Command1
      Caption         =   "&Add File"
      Height          =   375
      Index           =   0
      Left            =   6300
      TabIndex        =   9
      Top             =   420
      Width           =   1335
   End
   Begin PictureBox Picture3
      BackColor       =   &H00C0C0C0&
      BorderStyle     =   0  'None
      Height          =   3195
      Left            =   240
      ScaleHeight     =   3195
      ScaleWidth      =   5775
      TabIndex        =   0
      Top             =   360
      Width           =   5775
      Begin CheckBox chEnabled
         BackColor       =   &H00C0C0C0&
         Caption         =   "Shuffling E&nabled"
         Height          =   255
         Left            =   240
         TabIndex        =   6
         Top             =   2760
         Width           =   2775
      End
      Begin ListBox lbFiles
         Height          =   1395
         Left            =   1020
         TabIndex        =   4
         Top             =   1140
         Width           =   4455
      End
      Begin ComboBox coEvents
         Height          =   300
         Left            =   1020
         Style           =   2  'Dropdown List
         TabIndex        =   2
         Top             =   240
         Width           =   3315
      End
      Begin Label Label1
         BackColor       =   &H00C0C0C0&
         Caption         =   "Shuffle &Files:"
         Height          =   435
         Index           =   1
         Left            =   240
         TabIndex        =   3
         Top             =   1140
         Width           =   735
      End
      Begin Label laSound
         BackColor       =   &H00C0C0C0&
         Height          =   255
         Left            =   1620
         TabIndex        =   8
         Top             =   720
         Width           =   3975
      End
      Begin Label Label2
         BackColor       =   &H00C0C0C0&
         Caption         =   "Current Sound:"
         Height          =   255
         Left            =   240
         TabIndex        =   7
         Top             =   720
         Width           =   1335
      End
      Begin Label Label1
         BackColor       =   &H00C0C0C0&
         Caption         =   "&Event:"
         Height          =   255
         Index           =   0
         Left            =   240
         TabIndex        =   1
         Top             =   300
         Width           =   615
      End
   End
   Begin PictureBox Picture1
      BorderStyle     =   0  'None
      Height          =   255
      Left            =   0
      Picture         =   SOUND1.FRX:0302
      ScaleHeight     =   255
      ScaleWidth      =   375
      TabIndex        =   5
      Top             =   0
      Visible         =   0   'False
      Width           =   375
   End
Dim NewFlag As Integer
Sub chEnabled_Click ()
    If NewFlag Then Exit Sub
    x% = chEnabled.Value
    Key$ = coEvents.Text
    Res% = WritePrivateProfileString("Enabled", Key$, Str$(x%), "Shuffle.ini")
End Sub
Sub coEvents_Click ()
    UpdateFiles
    PassedString$ = Space$(gSize)
    Key$ = coEvents.Text
    a% = GetPrivateProfileString("Enabled", Key$, "", PassedString$, gSize, "Shuffle.ini")
    temp$ = Left$(PassedString$, a%)
    NewFlag = True
    If temp$ = "1" Then
    chEnabled.Value = 1
    Else
    chEnabled.Value = 0
    End If
    NewFlag = False
End Sub
Sub Command1_Click (Index As Integer)
Select Case Index
Case 0      'Add File
    CMDialog1.DefaultExt = "WAV"
    CMDialog1.DialogTitle = "Select Sound File"
    CMDialog1.FileName = ""
    CMDialog1.Filter = "Sound (*.wav)|*.wav"
    CMDialog1.FilterIndex = 1
    CMDialog1.Flags = OFN_FILEMUSTEXIST Or OFN_NOCHANGEDIR
    If gsInitDir <> "" Then CMDialog1.InitDir = gsInitDir
    CMDialog1.Action = 1
    FName$ = CMDialog1.FileName
    FTitle$ = CMDialog1.FileTitle
    If FName$ <> "" Then
    gsInitDir = Left$(FName$, Len(FName$) - Len(FTitle$) - 1)
    If Len(gsInitDir) < 3 Then gsInitDir = gsInitDir + "\"
    IniApp$ = coEvents.Text
    x% = InStr(FTitle$, ".")
    If x% <> 0 Then
        Key$ = Mid$(FTitle$, 1, x% - 1)
    Else
        Key$ = FTitle$
    End If
    a% = WritePrivateProfileString(IniApp$, Key$, FName$, "Shuffle.ini")
    UpdateFiles
    End If
Case 1      'Remove a file
    If lbFiles.ListIndex = -1 Then
    Msg$ = "Select a sound file to remove"
    MsgType% = MB_ICONASTERISK
    Title$ = "System Sound Shuffler"
    sMsgBox Msg$, MsgType%, Title$
    Exit Sub
    End If
    FName$ = lbFiles.Text
    Msg$ = "Are you sure you want to remove " + FName$ + "?"
    Title$ = "System Sound Shuffler"
    Res% = fMsgBox(Msg$, MB_ICONQUESTION + 3, Title$)
    If Res% = 6 Then
    LastNdx% = 1
    NextNdx% = 1
    Cut% = 0
    While NextNdx% <> 0
        NextNdx% = InStr(LastNdx%, FName$, "\")
        If NextNdx% <> 0 Then
        Cut% = NextNdx%
        End If
        LastNdx% = NextNdx% + 1
    Wend
    If Cut% <> 0 Then
        FName$ = Mid$(FName$, Cut% + 1)
    End If
    x% = InStr(FName$, ".")
    If x% Then FName$ = Left$(FName$, x% - 1)
    IniApp$ = coEvents.Text
    Res% = KillIniKey(IniApp$, FName$, 0&, "Shuffle.ini")
    UpdateFiles
    End If
Case 2      'Play selected file
    If lbFiles.ListIndex = -1 Then
    Msg$ = "Select a sound file to play"
    sMsgBox Msg$, MB_ICONASTERISK, "System Sound Shuffler"
    Exit Sub
    End If
    FName$ = lbFiles.Text
    Sound1.MousePointer = 11
    sndPlaySound FName$, 2
    Sound1.MousePointer = 0
Case 3      'Set Current
    MakeFileCurrent
Case 4      'Randomize
    MousePointer = 11
    Msg1.Show 0
    Junk% = DoEvents()
    Shuffle
    WinKey$ = gEventsArray(coEvents.ListIndex, 1)
    PassedString$ = Space$(gSize)
    a% = GetProfileString("Sounds", WinKey$, "[None]", PassedString$, gSize)
    x% = InStr(PassedString$, ",")
    If x% Then
    CurrentSound$ = Left$(PassedString$, x% - 1)
    Else
    CurrentSound$ = Left$(PassedString$, a%)
    End If
    laSound.Caption = CurrentSound$
    Unload Msg1
    MousePointer = 0
Case 5   'Done
    End
End Select
End Sub
Sub Form_Load ()
    Screen.MousePointer = 11
    WindowState = 0
    For x% = 1 To giNumEvents
    temp$ = gEventsArray(x% - 1, 0)
    coEvents.AddItem temp$
    Next
    coEvents.ListIndex = 0
    AutoRedraw = True
    ShadeForm Sound1
    AutoRedraw = False
    MakeBevel Picture3
    Screen.MousePointer = 0
End Sub
Sub lbFiles_DblClick ()
    If lbFiles.ListIndex = -1 Then
    Msg$ = "Select a sound file to play"
    sMsgBox Msg$, MB_ICONASTERISK, "System Sound Shuffler"
    Exit Sub
    End If
    FName$ = lbFiles.Text
    Sound1.MousePointer = 11
    sndPlaySound FName$, 2
    Sound1.MousePointer = 0
End Sub
Sub MakeFileCurrent ()
    If lbFiles.ListIndex = -1 Then
    Msg$ = "Select a sound file to make current"
    sMsgBox Msg$, MB_ICONASTERISK, "System Sound Shuffler"
    Exit Sub
    End If
    FName$ = lbFiles.Text
    Event$ = coEvents.Text
    WinKey$ = gEventsArray(coEvents.ListIndex, 1)
    a% = WriteProfileString("Sounds", WinKey$, FName$ + "," + Event$)
    laSound.Caption = FName$
End Sub
Sub UpdateFiles ()
'Get sound files for this event
    IniApp$ = coEvents.Text
    WinKey$ = gEventsArray(coEvents.ListIndex, 1)
    While lbFiles.ListCount
    lbFiles.RemoveItem 0
    Wend
    PassedString$ = Space$(gSize)
'First get current sound for this event
    a% = GetProfileString("Sounds", WinKey$, "[None]", PassedString$, gSize)
    x% = InStr(PassedString$, ",")
    If x% Then
    CurrentSound$ = Left$(PassedString$, x% - 1)
    Else
    CurrentSound$ = Left$(PassedString$, a%)
    End If
    laSound.Caption = CurrentSound$
    PassedString$ = Space$(gSize)
'Now get list of shuffle files for this event
    a% = GetIniSections(IniApp$, 0&, "", PassedString$, gSize, "Shuffle.ini")
    If a% = 0 Then Exit Sub   'there aren't any files
    Null$ = Chr$(0)
    Sections$ = Left$(PassedString$, a%)
    LastNdx = 0
    NextNdx = 1
    Counter = 0
'Files are separated by nulls so parse them
    While NextNdx > 0
    NextNdx = InStr(LastNdx + 1, Sections$, Null$)
    If NextNdx <> 0 Then
        Cut = NextNdx - LastNdx - 1
        temp$ = Mid$(Sections$, LastNdx + 1, Cut)
        PassedString$ = Space$(gSize)
        a% = GetPrivateProfileString(IniApp$, temp$, "", PassedString$, gSize, "Shuffle.ini")
        temp$ = Left$(PassedString$, a%)
        lbFiles.AddItem temp$
    End If
    LastNdx = NextNdx
    Wend
End Sub